home *** CD-ROM | disk | FTP | other *** search
/ Network CD 2 / Network CD - Volume 2.iso / twinopus / other / lhadir.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1994-12-23  |  17.0 KB  |  724 lines
  1. /*
  2.   $VER: LhADir.REXX 1.6 (7.4.94)
  3.   Copyright © 1993-1994 by EAV Productions International
  4.   Placed in the public domain. No restrictions on distribution or usage.
  5.  
  6.   This ARexx script for Directory Opus allows you to show the contents
  7.   (files and directories) of LhA archive files in a DOpus window and operate
  8.   on them as with a normal directory.
  9.  
  10.   Possible arguments (not case sensitive) for LhADir.REXX:
  11.  
  12.    GETDIR, BROWSE, PARENT, ROOT, DELETE, COPY, MOVE, MAKEDIR, GETSIZES,
  13.    READ, ANSIREAD, HEXREAD, SHOW, PLAY, LOOPPLAY, PRINT, ICONINFO, RUN,
  14.    VERSION, MULTIVIEW, AMIGAGUIDE, VIEWTEK, RETINADISPLAY.
  15. */
  16.  
  17.  
  18. signal on syntax    /* intercept syntax errors */
  19. options results        /* need results */
  20. options failat 21    /* external commands are allowed return code 20 */
  21. numeric digits 10    /* needed for convertdate routine */
  22. lf='a'x            /* ascii code for linefeed */
  23.  
  24. parse arg command portname . '"' selected '"'
  25. upper command
  26. if portname~=='' then
  27.    address(portname)
  28. else
  29.    portname=address()
  30. parse var portname '.' port  /* port number */
  31.  
  32. busy on            /* busy mouse pointer on */
  33. status 3        /* get active window */
  34. window=result
  35. status 9 window        /* get number of selected entries */
  36. entries=result
  37. checkabort        /* reset abort flag */
  38.  
  39. call checkconfig
  40. call checklhadir(window)
  41.  
  42. if selected~=='' then do
  43.    filetype=-1
  44.    entries=1
  45.    end
  46. else
  47.    if entries>0 then
  48.       call getnextone
  49.  
  50. topline=""
  51. listlha=0
  52. notmove=command~='MOVE'
  53. if pos('|'command'|','|GETDIR|BROWSE|PARENT|ROOT|DELETE|COPY|MOVE|MAKEDIR|GETSIZES|')>0 then
  54.    interpret 'call do'command
  55. else do
  56.    n=entries
  57.    async=pos('|'command'|','|READ|ANSIREAD|HEXREAD|')>0
  58.    internal=async|pos('|'command'|','|SHOW|PLAY|LOOPPLAY|PRINT|ICONINFO|RUN|')>0
  59.    if entries=0|async|(internal&~(lhadir&entries>0))|command='VERSION' then
  60.       n=1
  61.  
  62.    do n
  63.       checkabort  /* did the user press both mouse buttons? */
  64.       if result then
  65.      call quitit "Aborted..."
  66.  
  67.       if entries>0 then do
  68.      call getnextone
  69.      if lhadir then do
  70.         if filetype>0 then
  71.            call quitit "Error, cannot view directories."
  72.         address command 'LhA e -q -x2 -Qo "'patch(lhafile)'" T: "'patch(lhasubdir||selected)'"'
  73.         if rc>0 then
  74.            call quitit "Error while extracting file."
  75.         thisfile='"T:'selected'"'
  76.         end
  77.      else
  78.         if internal then
  79.            thisfile=''
  80.         else
  81.            thisfile='"'selected'"'
  82.      end
  83.  
  84.       if internal then do
  85.      interpret "'"command thisfile"'"
  86.      abort=result~=0
  87.      end
  88.       else do
  89.      if ~lhadir&entries>0 then
  90.         thisfile='"'winpath||selected'"'
  91.      query screenname
  92.      if result=0 then
  93.         screenname=portname  /* for compatibility */
  94.      else
  95.         screenname=result
  96.  
  97.      select  /* external commands */
  98.         when command='VERSION' then
  99.            call doversion
  100.         when command='MULTIVIEW' then
  101.            address command 'MultiView' thisfile 'PUBSCREEN' screenname
  102.         when command='AMIGAGUIDE' then
  103.            address command 'AmigaGuide' thisfile 'PUBSCREEN' screenname
  104.         when command='VIEWTEK' then
  105.            address command 'VT' thisfile
  106.         when command='RETINADISPLAY' then
  107.            address command 'RetinaDisplay' thisfile
  108.         otherwise call quitit "Error, LhADir.REXX does not support the command '"command"'."
  109.         end
  110.      abort=0
  111.      end
  112.  
  113.       busy on
  114.       if lhadir&entries>0 then do
  115.      if async then do
  116.         if ~show('l','rexxsupport.library') then
  117.            call addlib('rexxsupport.library',0,-30)  /* needed for delay() */
  118.         call delay(75)  /* wait a bit before deleting */
  119.         end
  120.      delete '"T:'selected'"'
  121.      busy on
  122.      end
  123.       if thisfile~=='' then do
  124.      selectfile '"'selected'" 0 1'  /* deselect item */
  125.      if topline=="" then
  126.         topline="OK"
  127.      end
  128.       if abort then
  129.      call quitit
  130.       end
  131.    end
  132.  
  133. call quitit topline  /* finished */
  134.  
  135.  
  136. dobrowse:
  137. dogetdir:
  138.  
  139.    if entries>0 then
  140.       if filetype>0 then  /* list a new dir */
  141.      if lhadir then
  142.         lhasubdir=lhasubdir||selected'/'
  143.      else
  144.         winpath=winpath||selected'/'
  145.       else do  /* list an archive file */
  146.      if pos('|'upper(right(selected,4)'|'),'|.LHA|.LZH|.RUN|')=0 then
  147.         call quitit "Error, LhADir.REXX can only list LhA archives."
  148.      if lhadir then do
  149.         request "This is an archive in an archive."lf"Extract it to 'T:' and then list it?"
  150.         uset=result
  151.         if uset then
  152.            destpath='T:'
  153.         else do
  154.            busy on
  155.            status 13 1-window  /* get window path */
  156.            destpath=result
  157.            if result=='' then
  158.           call quitit "Aborted..."
  159.            request "Use the current destination window"lf"'"destpath"' instead?"
  160.            if ~result then
  161.           call quitit "Aborted..."
  162.            end
  163.         busy on
  164.         toptext "Extracting from archive..."
  165.         address command 'LhA e -q -x2 -a -C0 -Qo "'patch(lhafile)'" "'destpath'" "'patch(lhasubdir||selected)'"'
  166.         if rc>0 then
  167.            call quitit "Error while extracting from archive."
  168.         if ~uset&command='GETDIR' then
  169.            rescan 1-window
  170.         lhafile=destpath||selected
  171.         end
  172.      else
  173.         lhafile=winpath||selected
  174.      lhadir=1
  175.      lhasubdir=''
  176.      listlha=1
  177.      end
  178.    else  /* rescan current dir */
  179.       if lhadir then do
  180.      status 6  /* get number of entries */
  181.      listlha=result>0
  182.      end
  183.  
  184.    if command='BROWSE' then do
  185.       selectfile '"'selected'" 0 1'
  186.       call swapactive
  187.       end
  188.    if lhadir then do
  189.       call showlhadir
  190.       topline="OK"
  191.       end
  192.    else
  193.       status 13 window set '"'winpath'"'
  194.    return
  195.  
  196.  
  197. doparent:
  198.  
  199.    if lhadir&lhasubdir~=='' then do
  200.       cuthere=lastpos('/',lhasubdir,length(lhasubdir)-1)
  201.       lhasubdir=left(lhasubdir,cuthere)
  202.       call showlhadir
  203.       topline="OK"
  204.       end
  205.    else
  206.       parent
  207.    return
  208.  
  209.  
  210. doroot:
  211.  
  212.    if lhadir&lhasubdir~=='' then do
  213.       lhasubdir=''
  214.       call showlhadir
  215.       topline="OK"
  216.       end
  217.    else
  218.       root
  219.    return
  220.  
  221.  
  222. dodelete:
  223.  
  224.    if lhadir then do
  225.       if entries=0 then
  226.      call quitit
  227.       if notmove then do
  228.      if askdelete then do
  229.         request "Do you really wish to delete selected entries"lf"from archive?"
  230.         if ~result then
  231.            call quitit "Aborted..."
  232.         busy on
  233.         end
  234.      call getall
  235.      end
  236.       call open('actionfile','T:actionfile'port,'w')
  237.       do i=1 to entries
  238.      if type.i>0 then
  239.         wild='/#?'
  240.      else
  241.         wild=''
  242.      call writeln('actionfile','"'patch(lhasubdir||name.i)||wild'"')
  243.      removefile '"'name.i'" 0'
  244.      end
  245.       call close('actionfile')
  246.       toptext "Deleting from archive..."
  247.       address command 'LhA d -q -Qp -Qo "'patch(lhafile)'" @T:actionfile'port
  248.       if rc>0 then do
  249.      topline="Error while deleting from archive."
  250.      listlha=1
  251.      call showlhadir
  252.      end
  253.       else do
  254.      topline="OK"
  255.      displaydir
  256.      end
  257.       delete 'T:actionfile'port
  258.       delete 'T:LhADir.list'port  /* archive contents has changed */
  259.       busy on
  260.       end
  261.    else do
  262.       if notmove then
  263.      restore
  264.       delete
  265.       end
  266.    return
  267.  
  268.  
  269. domove:
  270. docopy:
  271.  
  272.    if entries=0 then
  273.       call quitit
  274.    problem=0
  275.    source=winpath
  276.    s_lhadir=lhadir
  277.    s_lhafile=lhafile
  278.    s_lhasubdir=lhasubdir
  279.    call checklhadir(1-window)
  280.  
  281.    if s_lhadir then do
  282.       if winpath=='' then do
  283.      errortext="No destination directory selected!"
  284.      toptext errortext
  285.      notify errortext
  286.      call quitit
  287.      end
  288.       if lhadir then
  289.      winpath='T:LhADir'port'/'lhasubdir
  290.       call getall
  291.       call lhaextract
  292.       if lhadir then do
  293.      source=winpath
  294.      call lhaadd
  295.      end
  296.       else
  297.      rescan 1-window
  298.       end
  299.    else
  300.       if lhadir then do
  301.      call getall
  302.      call lhaadd
  303.      end
  304.       else do  /* normal copy/move */
  305.      restore
  306.      if notmove then
  307.         copy
  308.      else
  309.         move
  310.      end
  311.  
  312.    if (s_lhadir|lhadir)&~notmove&~problem then do
  313.       lhadir=s_lhadir
  314.       lhafile=s_lhafile
  315.       lhasubdir=s_lhasubdir
  316.       call dodelete
  317.       end
  318.    return
  319.  
  320.  
  321. domakedir:
  322.  
  323.    result=''
  324.    getstring '"Enter directory name"'
  325.    dirtomake=result
  326.    if dirtomake=='' then
  327.       call quitit
  328.    now=date('i')*86400+time('s')
  329.    if lhadir then do  /* create empty dir in archive */
  330.       call createdirs dirtomake'/'
  331.       address command 'LhA a -q -e -r -Qo "'patch(lhafile)'" T:LhADir'port'/' '"'patch(lhasubdir||dirtomake)'"'
  332.       if rc>0 then
  333.      topline="Error while adding to archive."
  334.       else do
  335.      topline="Directory created."
  336.      addfile '"'dirtomake'" 0 1' now '"" ----RWED 0 1'
  337.      end
  338.       delete 'T:LhADir'port
  339.       delete 'T:LhADir.list'port
  340.       busy on
  341.       end
  342.    else do
  343.       if upper(right(dirtomake,4))=='.LHA' then  /* create new archive */
  344.      if open('emptyarchive',winpath||dirtomake,'w') then do
  345.         call writech('emptyarchive','0'x)
  346.         call close('emptyarchive')
  347.         topline="Empty archive created."
  348.         addfile '"'dirtomake'" 1 -1' now '"" ----RWED 0 1'
  349.         end
  350.      else
  351.         topline="Error creating archive."
  352.       else do  /* normal makedir */
  353.      restore
  354.      makedir '"'dirtomake'"'
  355.      end
  356.       end
  357.    return
  358.  
  359.  
  360. dogetsizes:
  361.  
  362.    if lhadir then do
  363.       status 8 window  /* get number of dirs selected */
  364.       seldirs=result
  365.       getselecteddirs '/'
  366.       dirstring=result
  367.       ndirs=0
  368.       do seldirs
  369.      ndirs=ndirs+1
  370.      parse var dirstring dirname.ndirs '/' dirstring
  371.      fileinfo '"'dirname.ndirs'" /'
  372.      parse var result '/' filesize '/'
  373.      if filesize>0 then  /* already calculated */
  374.         ndirs=ndirs-1
  375.      end
  376.       dirsize.=0
  377.       dirsecs.=0
  378.       call readlist(0)
  379.       end
  380.    getsizes
  381.    return
  382.  
  383.  
  384. doversion:
  385.  
  386.    if entries=0 then
  387.       thisfile='REXX:LhADir.REXX'
  388.    toptext "Searching for version string..."
  389.    address command 'Version >T:Version.temp' thisfile 'FILE FULL'
  390.    call open('tempfile','T:Version.temp','r')
  391.    topline=readln('tempfile')
  392.    call close ('tempfile')
  393.    delete 'T:Version.temp'
  394.    return
  395.  
  396.  
  397. checklhadir:
  398.  
  399.    arg checkwindow
  400.    status 13 checkwindow  /* get window path */
  401.    winpath=result
  402.    test=upper(winpath)
  403.    cuthere=pos('.LHA/',test)
  404.    if cuthere=0 then
  405.       cuthere=pos('.LZH/',test)
  406.    if cuthere=0 then
  407.       cuthere=pos('.RUN/',test)
  408.    lhadir=cuthere>0
  409.    if lhadir then do
  410.       lhafile=left(winpath,cuthere+3)
  411.       lhasubdir=substr(winpath,cuthere+5)
  412.       end
  413.    return
  414.  
  415.  
  416. lhaextract:
  417.  
  418.    status 8 window  /* get number of dirs selected */
  419.    anydirs=result>0
  420.    mustmove=anydirs&s_lhasubdir~==''
  421.    if mustmove then
  422.       destpath=winpath'LhADir'port'/'
  423.    else
  424.       destpath=winpath
  425.  
  426.    call open('actionfile','T:actionfile'port,'w')
  427.    do i=1 to entries
  428.       if type.i>0 then
  429.      wild='/#?'
  430.       else
  431.      wild=''
  432.       call writeln('actionfile','"'patch(s_lhasubdir||name.i)||wild'"')
  433.       end
  434.    call close('actionfile')
  435.  
  436.    if anydirs then
  437.       lhacmd='x'
  438.    else
  439.       lhacmd='e -x2'
  440.  
  441.    toptext "Extracting from archive..."
  442.    address command 'LhA' lhacmd '-q -a -C0 -Qo "'patch(s_lhafile)'" "'destpath'" @T:actionfile'port
  443.    problem=rc>0
  444.    if problem then
  445.       topline="Error while extracting from archive."
  446.    else do
  447.       topline="OK"
  448.       if notmove then
  449.      none
  450.       end
  451.  
  452.    if mustmove then do
  453.       do i=1 to entries
  454.      move '"'winpath'LhADir'port'/'s_lhasubdir||name.i'" "'winpath'"'
  455.      end
  456.       delete '"'winpath'LhADir'port'"'
  457.       end
  458.    delete 'T:actionfile'port
  459.    busy on
  460.    return
  461.  
  462.  
  463. lhaadd:
  464.  
  465.    mustcopy=upper(right(source,length(lhasubdir)))~==upper(lhasubdir)
  466.    if mustcopy then do  /* all files must be copied to T: before they can be added */
  467.       homedir='T:LhADir'port'/'
  468.       call createdirs
  469.       end
  470.    else
  471.       homedir=left(source,length(source)-length(lhasubdir))
  472.    call open('actionfile','T:actionfile'port,'w')
  473.    call writeln('actionfile','"'patch(homedir)'"')
  474.  
  475.    if s_lhadir then
  476.       call writeln('actionfile','#?')
  477.    else do
  478.       do i=1 to entries
  479.      call writeln('actionfile','"'patch(lhasubdir||name.i)'"')
  480.      if mustcopy then do
  481.         copy '"'source||name.i'" "T:LhADir'port'/'lhasubdir'"'
  482.         busy on
  483.         end
  484.      end
  485.       end
  486.    call close('actionfile')
  487.  
  488.    toptext "Adding to archive..."
  489.    address command 'LhA r -q -e -r -Qo "'patch(lhafile)'" @T:actionfile'port
  490.    problem=rc>0
  491.    if problem then
  492.       topline="Error while adding to archive."
  493.    else do
  494.       topline="OK"
  495.       if notmove then
  496.      none
  497.       end
  498.    delete 'T:actionfile'port
  499.    if mustcopy|s_lhadir then
  500.       delete 'T:LhADir'port
  501.    busy on
  502.    call swapactive
  503.    listlha=1
  504.    call showlhadir
  505.    call swapactive
  506.    return
  507.  
  508.  
  509. lhalist:
  510.  
  511.    address command 'LhA >T:LhADir.list'port 'vv -N -Qw -Qo "'lhafile'"'
  512.    if rc>0 then do
  513.       setwintitle '"<Directory not available>"'
  514.       call quitit "Error while listing archive."
  515.       end
  516.    return
  517.  
  518.  
  519. getnextone:
  520.  
  521.    getnextselected
  522.    selected=result
  523.    if follow then
  524.       scrolltoshow '"'selected'"'
  525.    fileinfo '"'selected'" /'
  526.    parse var result '/' '/' '/' filetype '/'
  527.    return
  528.  
  529.  
  530. getall:
  531.  
  532.    getselectedall '/'
  533.    allselected=result
  534.    do i=1 to entries
  535.       parse var allselected name.i '/' allselected
  536.       fileinfo '"'name.i'" /'
  537.       parse var result '/' '/' '/' type.i '/'
  538.       end
  539.    return
  540.  
  541.  
  542. createdirs:
  543.  
  544.    parse arg subdir
  545.    dirstocreate='T:LhADir'port'/'lhasubdir||subdir
  546.    here=0
  547.    do forever
  548.       here=pos('/',dirstocreate,here+1)
  549.       if here=0 then
  550.      leave
  551.       makedir '"'left(dirstocreate,here-1)'"'
  552.       end
  553.    busy on
  554.    return
  555.  
  556.  
  557. swapactive:
  558.  
  559.    otherwindow
  560.    window=1-window
  561.    return
  562.  
  563.  
  564. showlhadir:
  565.  
  566.    status 13 window set '"'lhafile'/'lhasubdir'"'
  567.    toptext "Listing archive..."  /* toptext obscures error message */
  568.    setwintitle '"LhADir listed archive"'
  569.    now=date('i')*86400+time('s')
  570.    ndirs=0
  571.    call readlist(1)
  572.    return
  573.  
  574.  
  575. readlist:
  576.  
  577.    arg show  /* showdir or getsizes? */
  578.    if listlha|~exists('T:LhADir.list'port) then
  579.       call lhalist
  580.    call open('tempfile','T:LhADir.list'port,'r')
  581.    nextline=readln('tempfile')
  582.    parse var nextline 21 whicharc "':"
  583.    if upper(whicharc)~==upper(lhafile) then do  /* it's another archive's list */
  584.       call close('tempfile')
  585.       call lhalist
  586.       call open('tempfile','T:LhADir.list'port,'r')
  587.       call readln('tempfile')
  588.       end
  589.    do 2
  590.       call readln('tempfile')  /* waste these 2 lines */
  591.       end
  592.  
  593.    compstr=upper(lhasubdir)
  594.    complen=length(compstr)
  595.    nextline=readln('tempfile')
  596.  
  597.    do forever
  598.  
  599.       name=nextline
  600.       fileinfo=readln('tempfile')
  601.       do while substr(fileinfo,22,1)~=='%'
  602.      name=fileinfo
  603.      fileinfo=readln('tempfile')
  604.      end
  605.       if name=='-------- ------- ----- --------- --------' then
  606.      leave
  607.       nextline=readln('tempfile')
  608.       if left(nextline,1)==':' then do
  609.      parse var nextline 3 comment
  610.      nextline=readln('tempfile')
  611.      end
  612.       else
  613.      comment=''
  614.  
  615.       if upper(left(name,complen))==compstr then do
  616.      name=substr(name,complen+1)
  617.      if name~==''&pos('"',name)=0 then do
  618.         if pos('/',name)>0 then do  /* it's a dir */
  619.            parse var name dirname '/'
  620.            olddir=0
  621.            do i=ndirs to 1 by -1
  622.           if upper(dirname)==upper(dirname.i) then do
  623.              olddir=1
  624.              if ~show then do
  625.             toptext winpath||name
  626.             parse var fileinfo size . 24 datestamp 42
  627.             dirsize.i=dirsize.i+size
  628.             seconds=convertdate(datestamp)
  629.             if seconds>dirsecs.i then
  630.                dirsecs.i=seconds
  631.             end
  632.              leave
  633.              end
  634.           end
  635.            if show&~olddir then do  /* a new dir */
  636.           ndirs=ndirs+1
  637.           dirname.ndirs=dirname
  638.           addfile '"'dirname'" 0 1' now '"" ----RWED 0 0'
  639.           end
  640.            end
  641.         else  /* it's a file */
  642.            if show then do
  643.           parse var fileinfo size . 24 datestamp 42 43 atts .
  644.           seconds=convertdate(datestamp)
  645.           addfile '"'name'"' size '-1' seconds '"'comment'"' atts '0 0'
  646.           end
  647.         end
  648.      end
  649.       end
  650.    call close('tempfile')
  651.    if ~show then
  652.       do i=1 to ndirs
  653.      addfile '"'dirname.i'"' dirsize.i '1' dirsecs.i '"" ----RWED 0 0'
  654.      selectfile '"'dirname.i'"'
  655.      end
  656.    displaydir
  657.    return
  658.  
  659.  
  660. convertdate:  /* convert a file's date stamp to seconds past 01-Jan-78 */
  661.  
  662.    parse arg day '-' month '-' year ' ' hours ':' minutes ':' seconds
  663.    century=19+(year<78)
  664.    month=pos(month,'  JanFebMarAprMayJunJulAugSepOctNovDec')/3
  665.    month=right(month,2,'0')
  666.    return seconds+minutes*60+hours*3600+date('i',century||year||month||day,'s')*86400
  667.  
  668.  
  669. patch:  /* patch filenames containing pattern matching tokens */
  670.  
  671.    parse arg patched
  672.    pos=1
  673.    do forever
  674.       here=verify(substr(patched,pos),'#?|%()[]~*','m')
  675.       if here=0 then
  676.      leave
  677.       pos=pos+here+1
  678.       patched=insert("'",patched,pos-3)
  679.       end
  680.    return patched
  681.  
  682.  
  683. syntax:
  684.  
  685.    call quitit "Syntax Error" rc"," errortext(rc) "in line" sigl"."
  686.  
  687.  
  688. checkconfig:
  689.  
  690.    query dirflags
  691.    olddirflags=result
  692.    if olddirflags<0 then  /* bug in DOpus? */
  693.       olddirflags=256+olddirflags
  694.    if bittst(d2c(olddirflags),5) then do
  695.       request "The config setting 'Re-read changed buffers'"lf"must be switched off. Shall I do this for you?"
  696.       if ~result then do
  697.      remember  /* something to restore */
  698.      call quitit "Error, config setting 'Re-read changed buffers' must be switched off."
  699.      end
  700.       modify dirflags olddirflags-32
  701.       end
  702.  
  703.    remember                /* remember user settings */
  704.    busy on
  705.    query updateflags
  706.    follow=bittst(d2c(result),1)        /* scroll window to follow operations? */
  707.    modify updateflags 0            /* no progress indicator */
  708.    query deleteflags
  709.    askdelete=bittst(d2c(result),0)    /* ask before deleting? */
  710.    modify deleteflags 8            /* don't ask when deleting internal */
  711.    modify iconflags 0            /* no icons please */
  712.    return
  713.  
  714.  
  715. quitit:
  716.  
  717.    parse arg topline
  718.    restore                   /* restore user settings */
  719.    if topline~=="" then
  720.       toptext topline            /* display final message */
  721.    if pos("Error",topline)>0 then beep    /* an error occurred */
  722.    busy off                /* busy mouse pointer off */
  723.    exit                    /* stop script here */
  724.